home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / mp_foc.m < prev    next >
Text File  |  1992-05-12  |  12KB  |  441 lines
  1. /*
  2.  *    Plurals
  3.  *
  4.  *    Author:    S.C.Merrall
  5.  *
  6.  *    File:    mp_foc.m
  7.  *
  8.  *    Contents:    mp_if
  9.  *            mp_fi
  10.  *            mp_elif
  11.  *            mp_else
  12.  *            mp_and
  13.  *            mp_or
  14.  *            mp_not
  15.  *
  16.  *    Description:    These functions give a method of manipulating the 
  17.  *            active set. At this stage this can be easily made
  18.  *            to affect the existing primitives since all
  19.  *            primitives are accessed from the front end via
  20.  *            the function main.
  21.  *
  22.  *    Change History:
  23.  *
  24.  *    Date   Name Comment
  25.  *    -------- ---- -------
  26.  *    16:05:91 SCM  Created
  27.  *    23:06:91 SCM  Uses nil and not nil rather than a boolean integer
  28.  *    23:06:91 SCM  Added the boolean operators as they work with same types
  29.  *
  30.  */
  31.  
  32. #include <mpl.h>
  33. #include <stdio.h>
  34.  
  35. #include "constant.h"
  36.  
  37. #include "mp_object.h"
  38. #include "mp_debug_off.h"
  39. #include "mp_mem_mgmt.h"
  40. #include "mp_gc.h"
  41. #include "mp_type.h"
  42.  
  43. /*----------------------------------------------------------------------------*
  44.  * Function   : and
  45.  *
  46.  * Parameters : MP_PluralHeap MPPH_arg1:    MasPar Plural heap handles
  47.  *        MP_PluralHeap MPPH_arg2:    on the args and the results
  48.  *        MP_PluralHeap MPPH_result:    heap space.
  49.  *
  50.  * Description: Preforms the and operation in a lisp sense, i.e. it merely 
  51.  *        looks at the addresses, NIL corresponds to false and anything
  52.  *        else is true. The contents don't need to be examined since
  53.  *        nil has a unique address.
  54.  *
  55.  * Result     : int:    FAIL/SUCCESS
  56.  *---------------------------------------------------------------------------*/
  57.  
  58. #ifdef __STDC__
  59.  
  60. int and( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  61.      MP_PluralHeap MPPH_result )
  62.  
  63. #else
  64.  
  65. int and( MPPH_arg1, MPPH_arg2, MPPH_result )
  66.  
  67. MP_PluralHeap MPPH_arg1;
  68. MP_PluralHeap MPPH_arg2;
  69. MP_PluralHeap MPPH_result;
  70.  
  71. #endif
  72.  
  73. {
  74.   int result_status = SUCCESS;
  75. DBG_CALL("and");
  76. DBG_ARGS(DBG_PARG("MPPH_arg1","%x ",MPPH_arg1);DBG_PARG("\nMPPH_arg2","%x ",MPPH_arg2);DBG_PARG("\nMPPH_result","%x ",MPPH_result));
  77.  
  78. DEBUG(DBG_PARG("*MPPH_arg1","%d ",OA_offsets(MPPH_arg1)));
  79. DEBUG(DBG_PARG("*MPPH_arg2","%d ",OA_offsets(MPPH_arg2)));
  80.  
  81.  
  82.   if ((OA_offsets(MPPH_arg1) == NIL) || (OA_offsets(MPPH_arg2) == NIL)) {
  83.  
  84.     OA_offsets(MPPH_result) = NIL;
  85.   }
  86.   else {
  87.  
  88.     OA_offsets(MPPH_result) = NOT_NIL;
  89.   }
  90.  
  91. DBG_EXIT(fprintf(dbg,"SUCCESS");DBG_PARG("*MPPHH_result","%d ",OA_offsets(MPPH_result)));
  92.   return SUCCESS;
  93. }
  94.  
  95. /*----------------------------------------------------------------------------*
  96.  * Function   : or
  97.  *
  98.  * Parameters : MP_PluralHeap MPPH_arg1:    MasPar Plural heap handles
  99.  *        MP_PluralHeap MPPH_arg2:    on the args and the results
  100.  *        MP_PluralHeap MPPH_result:    heap space.
  101.  *
  102.  * Description: Preforms the or operation in a lisp sense, i.e. it merely 
  103.  *        looks at the addresses, NIL corresponds to false and anything
  104.  *        else is true. The contents don't need to be examined since
  105.  *        nil has a unique address.
  106.  *
  107.  * Result     : int:    FAIL/SUCCESS
  108.  *---------------------------------------------------------------------------*/
  109.  
  110. #ifdef __STDC__
  111.  
  112. int or( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_arg2, 
  113.      MP_PluralHeap MPPH_result )
  114.  
  115. #else
  116.  
  117. int or( MPPH_arg1, MPPH_arg2, MPPH_result )
  118.  
  119. MP_PluralHeap MPPH_arg1;
  120. MP_PluralHeap MPPH_arg2;
  121. MP_PluralHeap MPPH_result;
  122.  
  123. #endif
  124.  
  125. {
  126.   int result_status = SUCCESS;
  127. DBG_CALL("or");
  128. DBG_ARGS(DBG_PARG("MPPH_arg1","%x ",MPPH_arg1);DBG_PARG("\nMPPH_arg2","%x ",MPPH_arg2);DBG_PARG("\nMPPH_result","%x ",MPPH_result));
  129.  
  130. DEBUG(DBG_PARG("*MPPH_arg1","%d ",OA_offsets(MPPH_arg1)));
  131. DEBUG(DBG_PARG("*MPPH_arg2","%d ",OA_offsets(MPPH_arg2)));
  132.  
  133.   OA_offsets(MPPH_result) = NIL;
  134.  
  135.   if (OA_offsets(MPPH_arg1) != NIL) OA_offsets(MPPH_result) = NOT_NIL;
  136.  
  137.   if (OA_offsets(MPPH_arg2) != NIL) OA_offsets(MPPH_result) = NOT_NIL;
  138.  
  139. DBG_EXIT(fprintf(dbg,"SUCCESS");DBG_PARG("*MPPHH_result","%d ",OA_offsets(MPPH_result)));
  140.   return SUCCESS;
  141. }
  142.  
  143. /*----------------------------------------------------------------------------*
  144.  * Function   : not
  145.  *
  146.  * Parameters : MP_PluralHeap MPPH_arg1:    MasPar Plural heap handles
  147.  *        MP_PluralHeap MPPH_result:    on heap space.
  148.  *
  149.  * Description: Preforms the not operation in a lisp sense, i.e. it merely 
  150.  *        looks at the addresses, NIL corresponds to false and anything
  151.  *        else is true. The contents don't need to be examined since
  152.  *        nil has a unique address.
  153.  *
  154.  * Result     : int:    FAIL/SUCCESS
  155.  *---------------------------------------------------------------------------*/
  156.  
  157. #ifdef __STDC__
  158.  
  159. int not( MP_PluralHeap MPPH_arg1, MP_PluralHeap MPPH_result )
  160.  
  161. #else
  162.  
  163. int not( MPPH_arg1, MPPH_result )
  164.  
  165. MP_PluralHeap MPPH_arg1;
  166. MP_PluralHeap MPPH_result;
  167.  
  168. #endif
  169.  
  170. {
  171.   int result_status = SUCCESS;
  172. DBG_CALL("or");
  173. DBG_ARGS(fprintf(dbg,",MPPH_arg1=????,MPPH_arg3=????"));
  174.  
  175.   if (OA_offsets(MPPH_arg1) == NIL) OA_offsets(MPPH_result) = NOT_NIL;
  176.   else OA_offsets(MPPH_result) = NIL;
  177.  
  178. DBG_EXIT(fprintf(dbg,"SUCCESS:");DBG_PARG("","%d ",OA_offsets(MPPH_result)));
  179.   return SUCCESS;
  180. }
  181.  
  182. /*----------------------------------------------------------------------------*
  183.  * Function   : mp_if
  184.  *
  185.  * Parameters : MP_PluralHeap MPPH_boolean:    MasPar Plural Heap object, 
  186.  *                        handle on heap space of an 
  187.  *                        state.
  188.  *        MP_PluralHeap MPPH_context:    Top of current oontext stack
  189.  *
  190.  * Description:    The new context is calculated by combining the given
  191.  *        boolean with the one on the top of the context stack. This is
  192.  *        then put on to the top of the context stack.
  193.  *
  194.  * Result     : int:    FAIL/MP_NONE_ACTIVE/MP_SOME_ACTIVE
  195.  *---------------------------------------------------------------------------*/
  196.  
  197. #ifdef __STDC__
  198.  
  199. int mp_if( MP_PluralHeap MPPH_boolean, MP_PluralHeap MPPH_context )
  200.  
  201. #else
  202.  
  203. int mp_if( MPPH_boolean, MPPH_context )
  204.  
  205. MP_PluralHeap MPPH_boolean;
  206. MP_PluralHeap MPPH_context;
  207.  
  208. #endif
  209.  
  210. {
  211.   int result;
  212.   plural natural *plural old_context;
  213.   plural natural *plural new_context;
  214. DBG_CALL("mp_if");
  215. DBG_ARGS(fprintf(dbg,"MPPH_boolean=%04x,MPPH_context=%04x",MPPH_boolean,MPPH_context));
  216.  
  217. DBG_ARGS(DBG_PARG("MPPH_boolean","%x ",MPPH_boolean);DBG_PARG("\nMPPH_context","%x ",MPPH_context));
  218.  
  219.   old_context = (plural natural *plural) OA_data(MPPH_context);
  220.  
  221. /*DEBUG(DBG_PARG("boolean","%d",OA_offsets(MPPH_boolean)));
  222. DEBUG(DBG_PARG("car of stack","%d ",*old_context));
  223. DEBUG(DBG_PARG("cdr of stack","%d ",*(old_context + 1))); 
  224. */
  225.  
  226. DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));    
  227.  
  228.   if (cons(MPPH_boolean, MPPH_context, MPPH_context) == FAIL) {
  229.  
  230. DBG_FAIL(fprintf(dbg,"FAIL: Unable to cons up context stack"));
  231.     return FAIL;
  232.   }
  233.  
  234. DEBUG(DBG_PARG("ps[2589]","%d ",plural_memory[2589]));    
  235.  
  236.   new_context = (plural natural *plural) OA_data(MPPH_context);
  237.   *new_context = NIL;
  238.  
  239.   if (*old_context != NIL) {
  240.  
  241.     if (OA_offsets(MPPH_boolean) != NIL) *new_context = NOT_NIL;
  242.   }
  243.  
  244. /*DEBUG(DBG_PARG("car of stack","%d ",*new_context));
  245. DEBUG(DBG_PARG("cdr of stack","%d ",*(new_context + 1)));
  246. */
  247.   if(globalor(*new_context != NIL) == 0) result = MP_NONE_ACTIVE;
  248.   else result = MP_SOME_ACTIVE;
  249.  
  250. DBG_EXIT(fprintf(dbg,"%d",result));
  251.   return result;
  252. }
  253.  
  254.  
  255. /*----------------------------------------------------------------------------*
  256.  * Function   : mp_elif
  257.  *
  258.  * Parameters : MP_PluralHeap MPPH_stack:    Similarly for context stack
  259.  *
  260.  * Description: This operation is similar to fi, except it updates the 
  261.  *        state of the previous context, the running context, which
  262.  *        shows how many sites have yet to evaluate to true in a cond
  263.  *        expression which behaves in a way similar to switch
  264.  *
  265.  * Result     : int:    FAIL/MP_NONE_ACTIVE/MP_SOME_ACTIVE
  266.  *---------------------------------------------------------------------------*/
  267.  
  268. #ifdef __STDC__
  269.  
  270. int mp_elif( MP_PluralHeap MPPH_stack )
  271.  
  272. #else
  273.  
  274. int mp_elif(  MPPH_stack )
  275.  
  276. MP_PluralHeap MPPH_stack;
  277.  
  278. #endif
  279.  
  280. {
  281.   int result;
  282.   plural natural *plural old_context;
  283.   plural natural *plural running_context;
  284. DBG_CALL("mp_elif");
  285. DBG_ARGS(DBG_PARG("MPPH_stack","%04x ",MPPH_stack));
  286.  
  287.   old_context = (plural natural *plural) OA_data(MPPH_stack);
  288.   cdr( MPPH_stack, MPPH_stack );
  289.   running_context = (plural natural *plural) OA_data(MPPH_stack);
  290.  
  291.   if (*old_context == NOT_NIL) *running_context = NIL;
  292.  
  293.   if (globalor(*running_context != NIL) == 0) result = MP_SOME_ACTIVE;
  294.   else result = MP_NONE_ACTIVE;
  295.  
  296. DBG_EXIT(fprintf(dbg,"%d",result));
  297.   return result;
  298. }
  299.  
  300.  
  301. /*----------------------------------------------------------------------------*
  302.  * Function   : mp_else
  303.  *
  304.  * Parameters : MPPH_context:    Context stack to be elsified 
  305.  *
  306.  * Description: Pops the current context off the stack nots it and 
  307.  *        and ands that value with the top of the stack and pushses
  308.  *        this value back on to the stack.
  309.  *
  310.  * Result     : int FAIL/SUCCESS
  311.  *---------------------------------------------------------------------------*/
  312.  
  313. #ifdef __STDC__
  314.  
  315. int mp_else( MP_PluralHeap MPPH_context )
  316.  
  317. #else
  318.  
  319. int mp_else( MPPH_context )
  320.  
  321. MP_PluralHeap MPPH_context;
  322.  
  323. #endif
  324.  
  325. {
  326.   int result;
  327.   plural natural tmp;
  328.   MP_PluralHeap MPPH_tmp = &tmp;
  329.   plural natural *plural old_context;
  330.   plural natural *plural context;
  331. DBG_CALL("mp_else");
  332. DBG_ARGS(fprintf(dbg,"MPPH_context = ????"));
  333.  
  334.   if (cdr(MPPH_context, MPPH_tmp) == FAIL) {
  335.  
  336. DBG_FAIL(fprintf(dbg,"FAIL: cdr of context stack failed"));
  337.     return FAIL;
  338.   }
  339.  
  340.   old_context = (plural natural *plural) OA_data(MPPH_tmp);
  341.   context = (plural natural *plural) OA_data(MPPH_context);
  342.  
  343.   if (*old_context != NIL) {
  344.  
  345.     if (*context == NIL) *context = NOT_NIL;
  346.     else *context = NIL;
  347.   }
  348.  
  349.   if (globalor(*context != NIL) == 0) result = MP_NONE_ACTIVE;
  350.   else result = MP_SOME_ACTIVE;
  351.  
  352. DBG_EXIT(fprintf(dbg,"%d",result));
  353.   return result;
  354. }
  355.  
  356. /*----------------------------------------------------------------------------*
  357.  * Function   : mp_fi
  358.  *
  359.  * Parameters : MP_PluralHeap MPPH_context:    Top of current context stack
  360.  *
  361.  * Description:    Descends the context stack a level. If it goes beyond the
  362.  *        bottom of the stack this is an error.
  363.  *
  364.  * Result     : int:    SUCCESS/FAIL
  365.  *---------------------------------------------------------------------------*/
  366.  
  367. #ifdef __STDC__
  368.  
  369. int mp_fi( MP_PluralHeap MPPH_context )
  370.  
  371. #else
  372.  
  373. int mp_fi( MPPH_context )
  374.  
  375. MP_PluralHeap MPPH_context;
  376.  
  377. #endif
  378.  
  379. {
  380.   
  381. DBG_CALL("mp_fi");
  382. DBG_ARGS(fprintf(dbg,"MPPH_context=%04x",MPPH_context));
  383.  
  384.   if (cdr(MPPH_context,MPPH_context) == FAIL) {
  385.  
  386. DBG_FAIL(fprintf(dbg,"FAIL: cdr of context stack failed"));
  387.     return FAIL;
  388.   }
  389.  
  390. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  391.   return SUCCESS;
  392. }
  393.  
  394. /*----------------------------------------------------------------------------*
  395.  * Function   : make_context_stack
  396.  *
  397.  * Parameters : MPPH_context_stack:    MasPar Plural Heap (object), handle
  398.  *                    on heap space of context stack
  399.  *
  400.  * Description:    Each plural has a context stack associated with it.
  401.  *        Initially there was a global context stack however as 
  402.  *        different plurals could be allocated on the same PEs
  403.  *        they would interefere with each others context.
  404.  *        
  405.  * Result     : int:    FAIL/SUCCESS
  406.  *---------------------------------------------------------------------------*/
  407.  
  408. #ifdef __STDC__
  409.  
  410. int make_context_stack( MP_PluralHeap MPPH_context_stack )
  411.  
  412. #else
  413.  
  414.  
  415. int make_context_stack( MPPH_context_stack )
  416.  
  417. MP_PluralHeap MPPH_context_stack;
  418.  
  419. #endif
  420.  
  421. {
  422.   plural natural nil = (plural natural) NIL;
  423.   MP_PluralHeap MPPH_nil = &nil;
  424.   plural natural not_nil = (plural natural) NOT_NIL;
  425.   MP_PluralHeap MPPH_not_nil = ¬_nil;
  426. DBG_CALL("make_context_stack");
  427. DBG_ARGS(fprintf(dbg,"MPPH_context_stack = ????"));
  428.   GC_Protect(nil);
  429.   GC_Protect(not_nil);
  430.  
  431.   if (cons(MPPH_not_nil, MPPH_nil, MPPH_context_stack) == FAIL) {
  432.  
  433. DBG_FAIL(fprintf(dbg,"FAIL: Unable to create context stack"));
  434.     return FAIL;
  435.   }
  436.  
  437.   GC_UnProtect(2);
  438. DBG_EXIT(fprintf(dbg,"SUCCESS"));
  439.   return SUCCESS;
  440. }
  441.